Alle locaties met waterpest van 2011-2021 in het waterkwaliteitsportaal
Het waterkwaliteitsportaal
Alle monitoringsdata van de waterkwaliteit van de waterbeheerders wordt beschikbaar gesteld via het Waterkwaliteitsportaal (WKP). In deze blogpost wil ik laten zien hoe je deze data kunt downloaden en bewerken zodat je deze kunt gebruiken.
Onderstaande kaart met waterpest is een voorbeeld van een eindproduct dat je kunt maken met de WKP-data. Opvallend is dat er van sommige waterbeheerders helemaal geen of erg weinig locaties in het WKP aanwezig zijn. Dat laat zien dat het gebruik van WKP-data ook beperkingen heeft.
Downloaden en uitpakken van WKP-data
Tip
Je kunt de code-blokken inklappen door op de Code-knop boven aan het blok te klikken.
De data op het WKP wordt in verschillende ZIP-bestanden beschikbaar gesteld. De eerste stappen zijn om deze bestanden te downloaden en uit te pakken. In deze post maak ik alleen gebruik van data in het IM-metingen formaat vanaf 2016. Met de onderstaande code heb ik de bestanden gedownload en uitgepakt.
Ik maak gebruik van de functies walk en walk2. Deze functies maken het mogelijk om zonder loops de bestanden een voor een te downloaden en uit te pakken.
Tip
Je kunt in de codeblokken klikken en dan wordt je doorverwezen naar de documentatie van die functie.
Code
# Download
urls <-
c(
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/MeetgegevensPerJaar/IM_Metingen_2021.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/MeetgegevensPerJaar/IM_Metingen_2020.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/MeetgegevensPerJaar/IM_Metingen_2019.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/MeetgegevensPerJaar/IM_Metingen_2018.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/MeetgegevensPerJaar/IM_Metingen_2017.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/MeetgegevensPerJaar/IM_Metingen_2016.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2016-maand01_totenmet_04.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2016-maand05_totenmet_07.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2016-maand_08totenmet_12.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2015.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2014.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2013.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2012.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Meetgegevens/IM_Metingen_Biologie_2011.zip")
urls_meetpunten <-
c(
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2021.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2020.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2019.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2018.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2017.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2016.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2015.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2014.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2013.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2012.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Basisgegevens/Meetlocaties_2011.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Basisgegevens/Meetlocaties_Biologie_2015.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Basisgegevens/Meetlocaties_Biologie_2014.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Basisgegevens/Meetlocaties_Biologie_2013.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Basisgegevens/Meetlocaties_Biologie_2012.zip",
"https://waterkwaliteitsportaal.overheidsbestanden.nl/Oppervlaktewaterkwaliteit/Limno/Basisgegevens/Meetlocaties_Biologie_2011.zip"
)
dir.create("data-raw")
purrr::walk2(urls, paste0("data-raw/", basename(urls)), download.file)
purrr::walk2(urls_meetpunten, paste0("data-raw/", basename(urls_meetpunten)), download.file)
# Extract -----------------------------------------------------------------
# dir.create("data-raw/IM-metingen")
files <- list.files("data-raw", pattern = "^IM_Metingen", full.names = TRUE)
purrr::walk(files, .f = ~unzip(.x, exdir = "data-raw/IM-metingen"))
files_meetpunten <- list.files("data-raw", pattern = "^Meetlocaties", full.names = TRUE)
purrr::walk(files_meetpunten, .f = ~unzip(.x, exdir = "data-raw/meetpunten"))Het resultaat is dat we een map IM-metingen hebben met 31 bestanden en een map meetpunten met 16 bestanden met meetpunten.
Inlezen WKP-data
De volgende stap is om de uitgepakte bestanden in te lezen. Gezien het grote aantal bestanden is het handig om een aanpak te verzinnen waarbij niet ieder bestand afzonderlijk ingelezen hoeft te worden.
Eerste idee
Hoewel de bestanden allemaal in het IM-metingen format zijn, verschilt het aantal kolommen per bestand. Om dit probleem op te lossen was mijn eerste idee om elk afzonderlijk bestand automatisch in te lezen in een lijst met map(). Daarna combineer ik de data van al deze bestanden met reduce() en bind_rows().
Code
files_IM <- list.files("data-raw/IM-metingen/", full.names = TRUE)
data <-
map(files_IM, .f = read_csv2) %>%
reduce(bind_rows)Deze manier van inlezen werkt op zich wel, maar de voorwaarde is dat er genoeg computergeheugen beschikbaar is. Bij het uitproberen op mijn persoonlijke computer kwam ik erachter dat 8 GB RAM onvoldoende was en dat dit dus misschien niet de beste oplossing is.
Alternatieve aanpak
Alles in het geheugen inlezen is dus niet de optimale aanpak. Een betere aanpak is een database-achtige aanpak waarbij niet alle data in één keer in het geheugen ingelezen wordt, maar waarbij data pas wordt ingelezen wanneer dat nodig is.
Voor deze aanpak is het wel handig om de bestanden eerst te uniformeren en op te schonen. Ik gebruik deze stap ook gelijk om de meetpuntcoördinaten aan de IM-metingbestanden toe te voegen.
Opschonen meetpunten
Voor het opschonen van de meetpuntbestanden zijn er een paar aandachtspunten:
- Dezelfde informatie zit in de verschillende bestanden niet in dezelfde kolom. De namen verschillen en soms is het soort informatie een beetje verschillend.
- Er zijn soms onnodige aanhalingstekens toegevoegd, die haal ik weer weg.
- Veel meetpunten komen in meer dan 1 bestand voor. Het is wenselijk om voor elk meetpunt maar 1 set met informatie te hebben. Hiervoor maak ik een aparte tabel en bestand.
Code
files_mp <- list.files("data-raw/meetpunten/", full.names = TRUE)
meetpunten <-
tibble(pad = files_mp, bestandsnaam = basename(files_mp)) %>%
mutate(jaar = str_extract(bestandsnaam, "\\d{4}")) %>%
arrange(jaar) %>%
mutate(meetpuntinfo = map(pad, ~read_csv2(.x, col_types = cols(.default = col_character())))) %>%
unnest(meetpuntinfo) %>%
mutate(
Meetobject.namespace = case_when(
!is.na(Meetobject.namespace) ~ Meetobject.namespace,
!is.na(Namespace) ~ Namespace,
!is.na(Waterbeheerder.code) ~ paste0("NL", Waterbeheerder.code),
!is.na(sub_subident) ~ paste0("NL", sub_subident)),
Meetobject.lokaalID = coalesce(Identificatie, Meetpunt.identificatie, mpn_mpnident),
GeometriePunt.X_RD = coalesce(GeometriePunt.X_RD, mpn_mrfxcoor),
GeometriePunt.Y_RD = coalesce(GeometriePunt.Y_RD, mpn_mrfycoor),
Meetobject.Omschrijving = coalesce(Omschrijving, Meetpuntomschrijving, Meetpunt.omschrijving, mpn_mpnomsch)) %>%
select(Meetobject.namespace,
Meetobject.lokaalID,
Meetobject.Omschrijving,
GeometriePunt.X_RD,
GeometriePunt.Y_RD,
bestandsnaam,
jaar) %>%
mutate(across(where(is.character), ~str_remove_all(.x, '"'))) %>%
mutate(across(.cols = contains("GeometriePunt"),
.fns = ~parse_double(.x, locale = locale(decimal_mark = ".")))) %>%
distinct()
dir.create("data")
meetpunten %>% write_csv2("data/meetpunten_2011-2021.csv", na = "")
# Een aangepaste tabel met de meeste recente set coordinaten en zonder dummy coords.
meetpunten_clean <-
meetpunten %>%
filter(GeometriePunt.X_RD != 0, GeometriePunt.Y_RD != 0,
GeometriePunt.X_RD != 123546, GeometriePunt.Y_RD != 456789) %>%
arrange(desc(jaar)) %>%
group_by(Meetobject.namespace, Meetobject.lokaalID) %>%
summarise(GeometriePunt.X_RD = first(GeometriePunt.X_RD),
GeometriePunt.Y_RD = first(GeometriePunt.Y_RD),
Meetobject.Omschrijving = first(Meetobject.Omschrijving)) %>%
ungroup()
meetpunten_clean %>% write_csv2("data/meetpunten_2011-2021_clean.csv", na = "")Opschonen metingen
De volgende stap is het opschonen van de metingen bestanden. Dit doe ik door de volgende stappen:
- selectie van de noodzakelijke kolommen
- verwijderen van de overbodige aanhalingstekens
- het toevoegen van de meest recente coördinaten van ieder meetpunt.
Code
files_IM <- list.files("data-raw/IM-metingen/", full.names = TRUE)
dir.create("data/IM-metingen")
opschoon_fun <- function(filename){
im_kolommen <- c(
"Meetobject.namespace",
"Meetobject.lokaalID",
"MonsterCompartiment.code",
"Begindatum",
"Begintijd",
"Typering.code",
"Grootheid.code",
"Parameter.groep",
"Parameter.code",
"Parameter.omschrijving",
"Biotaxon.naam",
"Eenheid.code",
"Hoedanigheid.code",
"Levensstadium.code",
"Lengteklasse.code",
"Geslacht.code",
"Verschijningsvorm.code",
"Levensvorm.code",
"Gedrag.code",
"Waardebewerkingsmethode.code",
"Limietsymbool",
"Numeriekewaarde",
"Alfanumeriekewaarde",
"AnalyseCompartiment.code",
"Kwaliteitsoordeel.code")
read_csv2(filename,
col_types = cols(Numeriekewaarde = col_number(),
Begindatum = col_date(),
Begintijd = col_time(),
.default = col_character()),
col_select = any_of(im_kolommen),
locale = locale(decimal_mark = ".")) %>%
mutate(across(where(is.character), ~str_remove_all(.x, '"'))) %>%
left_join(meetpunten_clean, by = c("Meetobject.namespace", "Meetobject.lokaalID")) %>%
write_csv2(file.path("data/IM-metingen", basename(filename)),
na = "")
}
walk(files_IM, opschoon_fun)Gebruik WKP-data voor een concrete casus
We hebben de WKP-data nu beschikbaar in een vorm die we verder kunnen gebruiken. We kunnen deze data nu gaan gebruiken om vragen mee te beantwoorden. Als demonstratie gebruik ik de vraag: Waar in Nederland zijn er (uitheemse) rivierkreeften gerapporteerd?
Voor het inlezen van de data maak ik eerst een aparte functie zodat ik niet steeds hoef na te denken over de datatypen van de verschillende kolommen.
Code
read_wkp <- function(filename, lazy = FALSE){
read_csv2(filename,
col_types = cols(Begindatum = col_date(),
Begintijd = col_time(),
Numeriekewaarde = col_double(),
GeometriePunt.X_RD = col_double(),
GeometriePunt.Y_RD = col_double(),
.default = col_character()),
lazy = lazy)
}Ik gebruik de inleesfunctie om de opgeschoonde bestanden één voor één in te lezen en alleen de regels met kreeften te bewaren. Dat resulteert in een list met dataframes die ik samenvoeg met reduce(bind_rows).
Voor het weergeven van de data op een kaart download ik ook de waterschapsgrenzen van PDOK.
Code
kreeften_taxa <- twn_children("Astacidea", only_preferred = FALSE)
wkp_bestanden <- list.files("data/IM-metingen/", full.names = TRUE)
kreeften <-
map(wkp_bestanden, ~read_wkp(.x) %>% filter(Biotaxon.naam %in% kreeften_taxa)) %>%
reduce(bind_rows)
# Downloaden van waterschapsgrenzen van PDOK als achtergrond voor de kaarten
download.file("https://geodata.nationaalgeoregister.nl/hwh/eenheden/atom/v1_0/downloads/AdministrativeUnits.zip", "data/ws_grenzen.zip")
unzip("data/ws_grenzen.zip", exdir = "data")
ws_grenzen <- sf::st_read("data/AdministrativeUnits_ETRS89.gml", quiet = TRUE) %>% sf::st_transform(crs = 28992)Nu ik alle benodigde data heb ingelezen kan ik de data eindelijk gebruiken om leuke dingen mee te doen: zoals het weergeven per jaar waar er door waterschappen kreeften zijn waargenomen en gerapporteerd aan het waterkwaliteitsportaal.
Code
kreeften %>%
filter(!is.na(GeometriePunt.X_RD)) %>%
mutate(jaar = lubridate::year(Begindatum)) %>%
sf::st_as_sf(coords = c("GeometriePunt.X_RD", "GeometriePunt.Y_RD"), crs = 28992, remove = FALSE) %>%
ggplot() +
geom_sf(data = ws_grenzen, colour = "grey") +
geom_sf(alpha = 0.5) +
facet_wrap(~jaar) +
labs(title = "(Uitheemse) rivierkreeften gerapporteerd door de waterschappen",
caption = "Bron: https://www.waterkwaliteitsportaal.nl/")
Op kaartjes is ook te zien waarom ik ervoor heb gekozen om de kreeften te selecteren. Hier is namelijk duidelijk te zien dat HHSK vanaf 2020 de kreeften uitgebreid is gaan monitoren. Die monitoring is belangrijk ik hoop dat andere waterschappen ons voorbeeld zullen volgen.
Een alternatieve manier van inlezen
De library vroom kan een groot aantal tekstbestanden (.csv) indexeren en dit als een lazy1 dataframe beschikbaar maken. Om vroom te laten werken is het belangrijk dat alle bestanden dezelfde kolommen bevatten. Bij het opschonen van de bestanden hebben we deze stap al gemaakt.
1 Lazy betekent dat R zo weinig mogelijk werk doet. De data wordt dus niet in het geheugen geladen zolang dat niet nodig is.
Hieronder staat een code-voorbeeld met vroom voor de kreeftendata. Vroom is erg snel, maar vraagt wel nog steeds veel geheugen. Daarom heb ik hierboven voor een andere aanpak gekozen.
Code
kreeften <-
vroom::vroom(wkp_bestanden,
col_types = cols(Begindatum = col_date(),
Begintijd = col_time(),
Numeriekewaarde = col_double(),
GeometriePunt.X_RD = col_double(),
GeometriePunt.Y_RD = col_double(),
.default = col_character()),
locale = locale(decimal_mark = ",")) %>%
filter(Biotaxon.naam %in% kreeften_taxa)